home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / WIN / VB_DB / PROFIT.ZIP / VBINPUT.BAS < prev   
Encoding:
BASIC Source File  |  1992-12-06  |  24.8 KB  |  855 lines
  1.  
  2.  
  3. 'Program name:  vbinput.bas
  4. '               Visual Basic 1.0 input routines
  5. '     Version:  1.01
  6. '
  7. '   (c) 1991 by Keith Milligan
  8. '               100 Lee Road 605
  9. '               Smiths, AL 36877
  10. '               205-291-9712 Home
  11. '               205-298-1974 Work
  12. '               Compuserve ID = 70645,520
  13.  
  14. 'Use these routines if they will help you.  You may use,
  15. 'modify, copy, or distribute them with a clear concience.
  16.  
  17. 'Visual Basic 1.0 input routines
  18.  
  19. 'Version control information:
  20. '  1.00 - 07/01/91
  21. '    Initial release
  22. '  1.01 - 10/03/91
  23. '    Allow selected text to be replaced when the maximum
  24. '    length has been reached.
  25.  
  26. 'These routines use two events for each text control.
  27. 'There is a Sub for the KeyPress event and a corresponding
  28. 'Function for the LostFocus Event.  The KeyPress (KP) routine
  29. 'restricts certain keystrokes and the LostFocus (LF) routine
  30. 'validates the data entered in the text control and assigns
  31. 'the entered data to a variable.
  32.  
  33.  
  34. 'Date
  35. '  Sub DateKP(ThisControl, KeyAscii)
  36. '  Function  DateLF$(ThisControl, EarliestDate$)
  37. '  Format of EarliestDate$ is "yymmdd".
  38. '  Accepts date entered in one of the following formats:
  39. '     60491, 060491, 06/04/91, or 6/4/91
  40. '  Returns date in the format 910604.
  41.  
  42. 'MultPrice
  43. '  Sub MultPriceKP(ThisControl, KeyAscii)
  44. '  Function MultPriceLF$(ThisControl)
  45. '  Used to accept retail prices.  For example 3 for $1.00.
  46. '  Accepts and returns in the following formats:
  47. '    Input          Returns
  48. '     149           01/01.49
  49. '     1.49          01/01.49
  50. '     3/49          03/00.49
  51. '     3/.49         03/00.49
  52.  
  53. 'Point2
  54. '  Sub Point2KP(ThisControl, Length%, KeyAscii)
  55. '  Function Point2LF(ThisControl, Min#, Max#)
  56. '  Accepts number with two digits to the right of the decimal point.
  57. '  Maximum length = Length%
  58. '  Minimum value = Min#
  59. '  Maximum value = Max#
  60. '  Example 123.49
  61.  
  62. 'Point4
  63. '  Sub Point4KP(ThisControl, Length%, KeyAscii)
  64. '  Function Point4LF(ThisControl, Min#, Max#)
  65. '  Accepts number with four digits to the right of the decimal point.
  66. '  Maximum length = Length%
  67. '  Minimum value = Min#
  68. '  Maximum value = Max#
  69. '  Example 123.4978
  70.  
  71. 'Str
  72. '  Sub StrKP(ThisControl, Length%, KeyAscii)
  73. '  No LF function for this routine. Just move text to string in
  74. '    LostFocus Event.
  75. '  Accepts string of length less than or equal to Length%.
  76.  
  77. 'UCStr
  78. '  Sub UCStrKP(ThisControl, Length%, KeyAscii)
  79. '  No LF function for this routine just move text to string in
  80. '    LostFocus Event.
  81. '  Accepts string of length less than or equal to Length%.
  82. '  Converts characters to upper case as typed.
  83.  
  84. 'Long
  85. '  Sub LongKP(ThisControl, Length%, KeyAscii)
  86. '  Function LongLF&(ThisControl, Min&, Max&)
  87. '  Accepts long integer amount.
  88.  
  89. 'Int
  90. '  Sub IntKP(ThisControl, Length%, KeyAscii)
  91. '  Function IntLF%(ThisControl, Min%, Max%)
  92. '  Same as Long but accepts normal integer amounts
  93.  
  94. 'Curr2
  95. '  Sub Curr2KP(ThisControl, Length%, KeyAscii)
  96. '  Function Curr2LF@(ThisControl, Min@, Max@)
  97. '  Same as Point2 but for currency data type.
  98.  
  99. 'Curr4
  100. '  Sub Curr4KP(ThisControl, Length%, KeyAscii)
  101. '  Function Curr4LF(ThisControl, Min@, Max@)
  102. '  Same as Point4 but for currency data type.
  103.  
  104. 'DateSer
  105. '  Sub DateSerKP(Thiscontrol, KeyAscii)
  106. '  Function DateSerLF@(ThisControl, EarliestDate$)
  107. '  Same as Date but returns date serial number instead of yymmdd.
  108.  
  109. 'ProgBar
  110. '  Sub ProgBar(ThisControl, PDone%)
  111. '  This Control = a picture control with
  112. '     ScaleHeight = 1 and ScaleWidth = 100
  113. '  PDone% = Percent complete integer
  114.  
  115. 'SelectText
  116. '  Sub SelectText(ThisControl)
  117. '  Selects all the text in this control
  118.  
  119. '
  120. Sub Curr2KP (ThisControl As Control, Length%, KeyAscii As Integer)
  121.     If Len(ThisControl.Text) = Length% Then
  122.       If ThisControl.SelLength <> Length Then
  123.         If KeyAscii <> 8 Then
  124.           KeyAscii = 0
  125.           Beep
  126.         End If
  127.       End If
  128.     Else
  129.       C$ = Chr$(KeyAscii)
  130.       StringLength% = Len(ThisControl.Text)
  131.       DecimalPosition% = InStr(ThisControl.Text, ".")
  132.       If StringLength% - DecimalPosition% = 2 And DecimalPosition% <> 0 Then
  133.         If ThisControl.SelStart < DecimalPosition% Then
  134.           Select Case C$
  135.             Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8)
  136.             Case "-"
  137.               If ThisControl.SelStart <> 0 Or InStr(ThisControl.Text, "-") <> 0 Then
  138.                 KeyAscii = 0
  139.                 Beep
  140.               End If
  141.             Case "."
  142.               If ThisControl.SelLength <> Len(ThisControl.Text) Then
  143.                 KeyAscii = 0
  144.                 Beep
  145.               End If
  146.             Case Else
  147.               KeyAscii = 0
  148.               Beep
  149.           End Select
  150.         ElseIf KeyAscii <> 8 Then
  151.           KeyAscii = 0
  152.           Beep
  153.         End If
  154.       Else
  155.         Select Case C$
  156.           Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8)
  157.           Case "."
  158.             If InStr(ThisControl.Text, ".") <> 0 Then
  159.               KeyAscii = 0
  160.               Beep
  161.             End If
  162.           Case "-"
  163.             If ThisControl.SelStart <> 0 Or InStr(ThisControl.Text, "-") <> 0 Then
  164.               KeyAscii = 0
  165.               Beep
  166.             End If
  167.           Case Else
  168.             KeyAscii = 0
  169.             Beep
  170.         End Select
  171.       End If
  172.     End If
  173. End Sub
  174.  
  175. Function Curr2LF@ (ThisControl As Control, Min@, Max@)
  176.   Test@ = Val(ThisControl.Text)
  177.   If ThisControl.Text <> "" Then
  178.     If Test@ < Min@ Or Test@ > Max@ Then
  179.       Beep
  180.       Msg$ = "Number must be between " + Str$(Min@) + " and " + Str$(Max@)
  181.       MsgBox Msg$, 0, "Warning"
  182.       ThisControl.SetFocus
  183.     Else
  184.       Curr2LF@ = Test@
  185.     End If
  186.   End If
  187.  
  188. End Function
  189.  
  190. Sub Curr4KP (ThisControl As Control, Length%, KeyAscii As Integer)
  191.     If Len(ThisControl.Text) = Length% Then
  192.       If ThisControl.SelLength <> Length Then
  193.         If KeyAscii <> 8 Then
  194.           KeyAscii = 0
  195.           Beep
  196.         End If
  197.       End If
  198.     Else
  199.       C$ = Chr$(KeyAscii)
  200.       StringLength% = Len(ThisControl.Text)
  201.       DecimalPosition% = InStr(ThisControl.Text, ".")
  202.       If StringLength% - DecimalPosition% = 4 And DecimalPosition% <> 0 Then
  203.         If ThisControl.SelStart < DecimalPosition% Then
  204.           Select Case C$
  205.             Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8)
  206.             Case "-"
  207.               If ThisControl.SelStart <> 0 Or InStr(ThisControl.Text, "-") <> 0 Then
  208.                 KeyAscii = 0
  209.                 Beep
  210.               End If
  211.             Case "."
  212.               If ThisControl.SelLength <> Len(ThisControl.Text) Then
  213.                 KeyAscii = 0
  214.                 Beep
  215.               End If
  216.             Case Else
  217.               KeyAscii = 0
  218.               Beep
  219.           End Select
  220.         ElseIf KeyAscii <> 8 Then
  221.           KeyAscii = 0
  222.           Beep
  223.         End If
  224.       Else
  225.         Select Case C$
  226.           Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8)
  227.           Case "."
  228.             If InStr(ThisControl.Text, ".") <> 0 Then
  229.               KeyAscii = 0
  230.               Beep
  231.             End If
  232.           Case "-"
  233.             If ThisControl.SelStart <> 0 Or InStr(ThisControl.Text, "-") <> 0 Then
  234.               KeyAscii = 0
  235.               Beep
  236.             End If
  237.           Case Else
  238.             KeyAscii = 0
  239.             Beep
  240.         End Select
  241.       End If
  242.     End If
  243. End Sub
  244.  
  245. Function Curr4LF@ (ThisControl As Control, Min@, Max@)
  246.   Test@ = Val(ThisControl.Text)
  247.   If ThisControl.Text <> "" Then
  248.     If Test@ < Min@ Or Test@ > Max@ Then
  249.       Beep
  250.       Msg$ = "Number must be between " + Str$(Min@) + " and " + Str$(Max@)
  251.       MsgBox Msg$, 0, "Warning"
  252.       ThisControl.SetFocus
  253.     Else
  254.       Curr4LF@ = Test@
  255.     End If
  256.   End If
  257.  
  258. End Function
  259.  
  260. Sub DateKP (ThisControl As Control, KeyAscii As Integer)
  261.     C$ = Chr$(KeyAscii)
  262.     Test$ = ThisControl.Text
  263.     If Len(Test$) = 6 And InStr(Test$, "/") = 0 Then
  264.       If ThisControl.SelLength <> 6 Then
  265.         If KeyAscii <> 8 Then
  266.           KeyAscii = 0
  267.           Beep
  268.         End If
  269.       End If
  270.     ElseIf Len(Test$) = 8 And InStr(Test$, "/") <> 0 Then
  271.       If ThisControl.SelLength <> 8 Then
  272.         If KeyAscii <> 8 Then
  273.           KeyAscii = 0
  274.           Beep
  275.         End If
  276.       End If
  277.     Else
  278.         Select Case C$
  279.           Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8), "/"
  280.           Case Else
  281.             KeyAscii = 0
  282.             Beep
  283.         End Select
  284.     End If
  285. End Sub
  286.  
  287. Function DateLF$ (ThisControl As Control, EarliestDate$)
  288.   If ThisControl.Text <> "" Then
  289.     BadDate$ = "N"
  290.     InDate$ = ThisControl.Text
  291.     If Len(InDate$) = 5 Then
  292.       InDate$ = "0" + InDate$
  293.     ElseIf Len(InDate$) = 6 Then
  294.       If InStr(InDate$, "/") <> 0 Then
  295.         InDate$ = "0" + Left$(InDate$, 1) + "0" + Mid$(InDate$, 3, 1) + Mid$(InDate$, 5, 2)
  296.       End If
  297.     ElseIf Len(InDate$) = 7 Then
  298.       If Mid$(InDate$, 2, 1) = "/" Then
  299.         InDate$ = "0" + Left$(InDate$, 1) + Mid$(InDate$, 3, 2) + Mid$(InDate$, 6, 2)
  300.       Else
  301.         InDate$ = Left$(InDate$, 2) + "0" + Mid$(InDate$, 4, 1) + Mid$(InDate$, 6, 2)
  302.       End If
  303.     ElseIf Len(InDate$) = 8 Then
  304.       InDate$ = Left$(InDate$, 2) + Mid$(InDate$, 4, 2) + Mid$(InDate$, 7, 2)
  305.     Else
  306.       BadDate$ = "Y"
  307.     End If
  308.     If InStr(InDate$, "/") <> 0 And BadDate$ = "N" Then
  309.       Temp3$ = Right$(InDate$, 2)
  310.       If InStr(Temp3$, "/") <> 0 Then
  311.         BadDate$ = "Y"
  312.       End If
  313.     End If
  314.     If InStr(InDate$, "/") = 0 And BadDate$ = "N" Then
  315.       Months% = Val(Left$(InDate$, 2))
  316.       Days% = Val(Mid$(InDate$, 3, 2))
  317.       Select Case Months%
  318.         Case 1, 3, 5, 7, 8, 10, 12
  319.           If Days% < 1 Or Days% > 31 Then
  320.             BadDate$ = "Y"
  321.           End If
  322.         Case 4, 6, 9, 11
  323.           If Days% < 1 Or Days% > 30 Then
  324.             BadDate$ = "Y"
  325.           End If
  326.         Case 2
  327.           If Days% < 1 Or Days% > 29 Then
  328.              BadDate$ = "Y"
  329.           End If
  330.         Case Else
  331.           BadDate$ = "Y"
  332.       End Select
  333.     End If
  334.     InDate$ = Mid$(InDate$, 5, 2) + Left$(InDate$, 4)
  335.     If InDate$ < EarliestDate$ And Left$(InDate$, 2) > "30" Then
  336.       BadDate$ = "Y"
  337.     End If
  338.     If BadDate$ = "Y" Then
  339.       Beep
  340.       Msg$ = "Not a valid date."
  341.       MsgBox Msg$, 0, "Warning"
  342.       ThisControl.SetFocus
  343.     Else
  344.       If Left$(InDate$, 2) > "20" Then
  345.         InDate$ = "19" + InDate$
  346.       Else
  347.         InDate$ = "20" + InDate$
  348.       End If
  349.       Temp# = DateSerial(Val(Left$(InDate$, 4)), Val(Mid$(InDate$, 5, 2)), Val(Mid$(InDate$, 7, 2)))
  350.       ThisControl.Text = Format$(Temp#, "mm/dd/yy")
  351.       Temp2$ = ThisControl.Text
  352.       DateLF$ = Right$(Temp2$, 2) + Left$(Temp2$, 2) + Mid$(Temp2$, 4, 2)
  353.     End If
  354.   End If
  355. End Function
  356.  
  357. Sub DateSerKP (ThisControl As Control, KeyAscii As Integer)
  358.     C$ = Chr$(KeyAscii)
  359.     Test$ = ThisControl.Text
  360.     If Len(Test$) = 6 And InStr(Test$, "/") = 0 Then
  361.       If ThisControl.SelLength <> 6 Then
  362.         If KeyAscii <> 8 Then
  363.           KeyAscii = 0
  364.           Beep
  365.         End If
  366.       End If
  367.     ElseIf Len(Test$) = 8 And InStr(Test$, "/") <> 0 Then
  368.       If ThisControl.SelLength <> 8 Then
  369.         If KeyAscii <> 8 Then
  370.           KeyAscii = 0
  371.           Beep
  372.         End If
  373.       End If
  374.     Else
  375.         Select Case C$
  376.           Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8), "/"
  377.           Case Else
  378.             KeyAscii = 0
  379.             Beep
  380.         End Select
  381.     End If
  382. End Sub
  383.  
  384. Function DateSerLF# (ThisControl As Control, EarliestDate$)
  385.   If ThisControl.Text <> "" Then
  386.     BadDate$ = "N"
  387.     InDate$ = ThisControl.Text
  388.     If Len(InDate$) = 5 Then
  389.       InDate$ = "0" + InDate$
  390.     ElseIf Len(InDate$) = 6 Then
  391.       If InStr(InDate$, "/") <> 0 Then
  392.         InDate$ = "0" + Left$(InDate$, 1) + "0" + Mid$(InDate$, 3, 1) + Mid$(InDate$, 5, 2)
  393.       End If
  394.     ElseIf Len(InDate$) = 7 Then
  395.       If Mid$(InDate$, 2, 1) = "/" Then
  396.         InDate$ = "0" + Left$(InDate$, 1) + Mid$(InDate$, 3, 2) + Mid$(InDate$, 6, 2)
  397.       Else
  398.         InDate$ = Left$(InDate$, 2) + "0" + Mid$(InDate$, 4, 1) + Mid$(InDate$, 6, 2)
  399.       End If
  400.     ElseIf Len(InDate$) = 8 Then
  401.       InDate$ = Left$(InDate$, 2) + Mid$(InDate$, 4, 2) + Mid$(InDate$, 7, 2)
  402.     Else
  403.       BadDate$ = "Y"
  404.     End If
  405.     If InStr(InDate$, "/") <> 0 And BadDate$ = "N" Then
  406.       Temp3$ = Right$(InDate$, 2)
  407.       If InStr(Temp3$, "/") <> 0 Then
  408.         BadDate$ = "Y"
  409.       End If
  410.     End If
  411.     If InStr(InDate$, "/") = 0 And BadDate$ = "N" Then
  412.       Months% = Val(Left$(InDate$, 2))
  413.       Days% = Val(Mid$(InDate$, 3, 2))
  414.       Select Case Months%
  415.         Case 1, 3, 5, 7, 8, 10, 12
  416.           If Days% < 1 Or Days% > 31 Then
  417.             BadDate$ = "Y"
  418.           End If
  419.         Case 4, 6, 9, 11
  420.           If Days% < 1 Or Days% > 30 Then
  421.             BadDate$ = "Y"
  422.           End If
  423.         Case 2
  424.           If Days% < 1 Or Days% > 29 Then
  425.              BadDate$ = "Y"
  426.           End If
  427.         Case Else
  428.           BadDate$ = "Y"
  429.       End Select
  430.     End If
  431.     InDate$ = Mid$(InDate$, 5, 2) + Left$(InDate$, 4)
  432.     If InDate$ < EarliestDate$ And Left$(InDate$, 2) > "30" Then
  433.       BadDate$ = "Y"
  434.     End If
  435.     If BadDate$ = "Y" Then
  436.       Beep
  437.       Msg$ = "Not a valid date."
  438.       MsgBox Msg$, 0, "Warning"
  439.       ThisControl.SetFocus
  440.     Else
  441.       If Left$(InDate$, 2) > "20" Then
  442.         InDate$ = "19" + InDate$
  443.       Else
  444.         InDate$ = "20" + InDate$
  445.       End If
  446.       Temp# = DateSerial(Val(Left$(InDate$, 4)), Val(Mid$(InDate$, 5, 2)), Val(Mid$(InDate$, 7, 2)))
  447.       DateSerLF# = Temp#
  448.       ThisControl.Text = Format$(Temp#, "mm/dd/yy")
  449.     End If
  450.   End If
  451.  
  452. End Function
  453.  
  454. Function FileExists% (FileName$)
  455.   On Error GoTo FEErrorCode
  456.   FileNum = FreeFile
  457.   Open FileName$ For Random As FileNum Len = 1
  458.   If LOF(FileNum) = 0 Then
  459.     Close FileNum
  460.     Kill FileName$
  461.     FileExists% = False
  462.   Else
  463.     Close FileNum
  464.     FileExists% = True
  465.   End If
  466.   Exit Function
  467. FEErrorCode:
  468.   FileExists% = False
  469.   Resume FEErrorExit
  470. FEErrorExit:
  471.  
  472. End Function
  473.  
  474. Sub IntKP (ThisControl As Control, Length%, KeyAscii As Integer)
  475.     If Len(ThisControl.Text) = Length% Then
  476.       If ThisControl.SelLength <> Length Then
  477.         If KeyAscii <> 8 Then
  478.           KeyAscii = 0
  479.           Beep
  480.         End If
  481.       End If
  482.     Else
  483.       C$ = Chr$(KeyAscii)
  484.       Select Case C$
  485.         Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8)
  486.         Case "-"
  487.           If ThisControl.SelStart <> 0 Or InStr(ThisControl.Text, "-") <> 0 Then
  488.             KeyAscii = 0
  489.             Beep
  490.           End If
  491.         Case Else
  492.           KeyAscii = 0
  493.           Beep
  494.       End Select
  495.     End If
  496. End Sub
  497.  
  498. Function IntLF% (ThisControl As Control, Min%, Max%)
  499.   On Local Error GoTo ErrorHandler
  500.   Test% = Val(ThisControl.Text)
  501.   If ThisControl.Text <> "" Then
  502.     If Test% < Min% Or Test% > Max% Then
  503.       Beep
  504.       Msg$ = "Number must be between " + Str$(Min%) + " and " + Str$(Max%)
  505.       MsgBox Msg$, 0, "Warning"
  506.       ThisControl.SetFocus
  507.     Else
  508.       IntLF% = Test%
  509.     End If
  510.   End If
  511.   Exit Function
  512. ErrorHandler:
  513.   Beep
  514.   Msg$ = "The number must be a valid integer amount."
  515.   MsgBox Msg$, 0, "Warning"
  516.   ThisControl.SetFocus
  517.   Resume EndErrorHandler
  518. EndErrorHandler:
  519. End Function
  520.  
  521. Sub LongKP (ThisControl As Control, Length%, KeyAscii As Integer)
  522.     If Len(ThisControl.Text) = Length% Then
  523.       If ThisControl.SelLength <> Length Then
  524.         If KeyAscii <> 8 Then
  525.           KeyAscii = 0
  526.           Beep
  527.         End If
  528.       End If
  529.     Else
  530.       C$ = Chr$(KeyAscii)
  531.       Select Case C$
  532.         Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8)
  533.         Case "-"
  534.           If ThisControl.SelStart <> 0 Or InStr(ThisControl.Text, "-") <> 0 Then
  535.             KeyAscii = 0
  536.             Beep
  537.           End If
  538.         Case Else
  539.           KeyAscii = 0
  540.           Beep
  541.       End Select
  542.     End If
  543. End Sub
  544.  
  545. Function LongLF& (ThisControl As Control, Min&, Max&)
  546.   On Local Error GoTo ErrorHandler2
  547.   Test& = Val(ThisControl.Text)
  548.   If ThisControl.Text <> "" Then
  549.     If Test& < Min& Or Test& > Max& Then
  550.       Beep
  551.       Msg$ = "Number must be between " + Str$(Min&) + " and " + Str$(Max&)
  552.       MsgBox Msg$, 0, "Warning"
  553.       ThisControl.SetFocus
  554.     Else
  555.       LongLF& = Test&
  556.     End If
  557.   End If
  558.   Exit Function
  559. ErrorHandler2:
  560.   Beep
  561.   Msg$ = "The number must be a valid long integer amount."
  562.   MsgBox Msg$, 0, "Warning"
  563.   ThisControl.SetFocus
  564.   Resume EndErrorHandler2
  565. EndErrorHandler2:
  566. End Function
  567.  
  568. Sub MultPriceKP (ThisControl As Control, KeyAscii As Integer)
  569.     C$ = Chr$(KeyAscii)
  570.     Test$ = ThisControl.Text
  571.     If Len(Test$) = 5 And InStr(Test$, "/") = 0 Then
  572.       If ThisControl.SelLength <> 5 Then
  573.         If KeyAscii <> 8 Then
  574.           KeyAscii = 0
  575.           Beep
  576.         End If
  577.       End If
  578.     ElseIf Len(Test$) = 8 And InStr(Test$, "/") <> 0 Then
  579.       If ThisControl.SelLength <> 8 Then
  580.         If KeyAscii <> 8 Then
  581.           KeyAscii = 0
  582.           Beep
  583.         End If
  584.       End If
  585.     Else
  586.       StringLength% = Len(ThisControl.Text)
  587.       DecimalPosition% = InStr(ThisControl.Text, ".")
  588.       If StringLength% - DecimalPosition% = 2 And DecimalPosition% <> 0 Then
  589.         If ThisControl.SelLength <> StringLength% Then
  590.           If KeyAscii <> 8 Then
  591.             KeyAscii = 0
  592.             Beep
  593.           End If
  594.         End If
  595.       Else
  596.         Select Case C$
  597.           Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8)
  598.           Case "."
  599.             If InStr(ThisControl.Text, ".") <> 0 Then
  600.               KeyAscii = 0
  601.               Beep
  602.             End If
  603.           Case "/"
  604.             If InStr(ThisControl.Text, "/") <> 0 Or InStr(ThisControl.Text, ".") <> 0 Then
  605.               KeyAscii = 0
  606.               Beep
  607.             End If
  608.           Case Else
  609.             KeyAscii = 0
  610.             Beep
  611.         End Select
  612.       End If
  613.     End If
  614. End Sub
  615.  
  616. Function MultPriceLF$ (ThisControl As Control)
  617.   If Len(ThisControl.Text) <> 0 Then
  618.     BadQuantity$ = "N"
  619.     BadAmount$ = "N"
  620.     Temp$ = ThisControl.Text
  621.     If InStr(Temp$, "/") = 0 Then
  622.       Qty$ = "01"
  623.       Amt$ = Temp$
  624.     Else
  625.       Qty$ = Left$(Temp$, InStr(Temp$, "/") - 1)
  626.       Amt$ = Right$(Temp$, Len(Temp$) - InStr(Temp$, "/"))
  627.     End If
  628.     QtyLength% = Len(Qty$)
  629.     Select Case QtyLength%
  630.       Case 1
  631.         Qty$ = "0" + Qty$
  632.       Case 2
  633.       Case Else
  634.         BadQuantity$ = "Y"
  635.     End Select
  636.     If InStr(Amt$, ".") = 0 Then
  637.       Amt$ = Left$(Amt$, Len(Amt$) - 2) + "." + Right$(Amt$, 2)
  638.     End If
  639.     If InStr(Amt$, ".") = Len(Amt$) - 1 Then
  640.       Amt$ = Amt$ + "0"
  641.     End If
  642.     If InStr(Amt$, ".") = Len(Amt$) Then
  643.       Amt$ = Amt$ + "00"
  644.     End If
  645.     Amt$ = String$(5 - Len(Amt$), "0") + Amt$
  646.     If Val(Amt$) > 99.99 Or Val(Amt$) < .01 Then
  647.       BadAmount$ = "Y"
  648.     End If
  649.     If Val(Qty$) > 99 Or Val(Qty$) < 1 Then
  650.       BadQuantity$ = "Y"
  651.     End If
  652.     If BadAmount$ = "Y" Then
  653.       Beep
  654.       Msg$ = "Price is not valid."
  655.       MsgBox Msg$, 0, "Warning"
  656.       ThisControl.SetFocus
  657.     ElseIf BadQuantity$ = "Y" Then
  658.       Beep
  659.       Msg$ = "Quantity is not valid."
  660.       MsgBox Msg$, 0, "Warning"
  661.       ThisControl.SetFocus
  662.     Else
  663.       ThisControl.Text = Qty$ + "/" + Amt$
  664.       MultPriceLF$ = ThisControl.Text
  665.     End If
  666.   End If
  667. End Function
  668.  
  669. Sub Point2KP (ThisControl As Control, Length%, KeyAscii As Integer)
  670.     If Len(ThisControl.Text) = Length% Then
  671.       If ThisControl.SelLength <> Length Then
  672.         If KeyAscii <> 8 Then
  673.           KeyAscii = 0
  674.           Beep
  675.         End If
  676.       End If
  677.     Else
  678.       C$ = Chr$(KeyAscii)
  679.       StringLength% = Len(ThisControl.Text)
  680.       DecimalPosition% = InStr(ThisControl.Text, ".")
  681.       If StringLength% - DecimalPosition% = 2 And DecimalPosition% <> 0 Then
  682.         If ThisControl.SelStart < DecimalPosition% Then
  683.           Select Case C$
  684.             Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8)
  685.             Case "-"
  686.               If ThisControl.SelStart <> 0 Or InStr(ThisControl.Text, "-") <> 0 Then
  687.                 KeyAscii = 0
  688.                 Beep
  689.               End If
  690.             Case "."
  691.               If ThisControl.SelLength <> Len(ThisControl.Text) Then
  692.                 KeyAscii = 0
  693.                 Beep
  694.               End If
  695.             Case Else
  696.               KeyAscii = 0
  697.               Beep
  698.           End Select
  699.         ElseIf KeyAscii <> 8 Then
  700.           KeyAscii = 0
  701.           Beep
  702.         End If
  703.       Else
  704.         Select Case C$
  705.           Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8)
  706.           Case "."
  707.             If InStr(ThisControl.Text, ".") <> 0 Then
  708.               KeyAscii = 0
  709.               Beep
  710.             End If
  711.           Case "-"
  712.             If ThisControl.SelStart <> 0 Or InStr(ThisControl.Text, "-") <> 0 Then
  713.               KeyAscii = 0
  714.               Beep
  715.             End If
  716.           Case Else
  717.             KeyAscii = 0
  718.             Beep
  719.         End Select
  720.       End If
  721.     End If
  722. End Sub
  723.  
  724. Function Point2LF# (ThisControl As Control, Min#, Max#)
  725.   Test# = Val(ThisControl.Text)
  726.   If ThisControl.Text <> "" Then
  727.     If Test# < Min# Or Test# > Max# Then
  728.       Beep
  729.       Msg$ = "Number must be between " + Str$(Min#) + " and " + Str$(Max#)
  730.       MsgBox Msg$, 0, "Warning"
  731.       ThisControl.SetFocus
  732.     Else
  733.       Point2LF# = Test#
  734.     End If
  735.   End If
  736. End Function
  737.  
  738. Sub Point4KP (ThisControl As Control, Length%, KeyAscii As Integer)
  739.     If Len(ThisControl.Text) = Length% Then
  740.       If ThisControl.SelLength <> Length Then
  741.         If KeyAscii <> 8 Then
  742.           KeyAscii = 0
  743.           Beep
  744.         End If
  745.       End If
  746.     Else
  747.       C$ = Chr$(KeyAscii)
  748.       StringLength% = Len(ThisControl.Text)
  749.       DecimalPosition% = InStr(ThisControl.Text, ".")
  750.       If StringLength% - DecimalPosition% = 4 And DecimalPosition% <> 0 Then
  751.         If ThisControl.SelStart < DecimalPosition% Then
  752.           Select Case C$
  753.             Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8)
  754.             Case "-"
  755.               If ThisControl.SelStart <> 0 Or InStr(ThisControl.Text, "-") <> 0 Then
  756.                 KeyAscii = 0
  757.                 Beep
  758.               End If
  759.             Case "."
  760.               If ThisControl.SelLength <> Len(ThisControl.Text) Then
  761.                 KeyAscii = 0
  762.                 Beep
  763.               End If
  764.             Case Else
  765.               KeyAscii = 0
  766.               Beep
  767.           End Select
  768.         ElseIf KeyAscii <> 8 Then
  769.           KeyAscii = 0
  770.           Beep
  771.         End If
  772.       Else
  773.         Select Case C$
  774.           Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8)
  775.           Case "."
  776.             If InStr(ThisControl.Text, ".") <> 0 Then
  777.               KeyAscii = 0
  778.               Beep
  779.             End If
  780.           Case "-"
  781.             If ThisControl.SelStart <> 0 Or InStr(ThisControl.Text, "-") <> 0 Then
  782.               KeyAscii = 0
  783.               Beep
  784.             End If
  785.           Case Else
  786.             KeyAscii = 0
  787.             Beep
  788.         End Select
  789.       End If
  790.     End If
  791. End Sub
  792.  
  793. Function Point4LF# (ThisControl As Control, Min#, Max#)
  794.   Test# = Val(ThisControl.Text)
  795.   If ThisControl.Text <> "" Then
  796.     If Test# < Min# Or Test# > Max# Then
  797.       Beep
  798.       Msg$ = "Number must be between " + Str$(Min#) + " and " + Str$(Max#)
  799.       MsgBox Msg$, 0, "Warning"
  800.       ThisControl.SetFocus
  801.     Else
  802.       Point4LF# = Test#
  803.     End If
  804.   End If
  805. End Function
  806.  
  807.  
  808. Sub ProgBar (ThisControl As Control, PDone%)
  809.    TotHeight% = ThisControl.ScaleHeight
  810.    TotWidth% = ThisControl.ScaleWidth
  811.    DoneWidth% = TotWidth% * (PDone% / 100)
  812.    ThisControl.Line (DoneWidth%, 0)-(TotWidth%, TotHeight%), RGB(255, 255, 255), BF
  813.    ThisControl.Line (0, 0)-(DoneWidth%, TotHeight%), RGB(0, 0, 128), BF
  814.    Pct$ = Format$(PDone, " ##\% ")
  815.    If PDone < 50 Then
  816.       ThisControl.CurrentX = DoneWidth%
  817.       ThisControl.ForeColor = RGB(0, 0, 0)
  818.    Else
  819.       ThisControl.CurrentX = DoneWidth% - ThisControl.TextWidth(Pct$)
  820.       ThisControl.ForeColor = RGB(255, 255, 255)
  821.    End If
  822.    ThisControl.CurrentY = (TotHeight% - ThisControl.TextHeight(Pct$)) / 2
  823.    ThisControl.Print Pct$
  824. End Sub
  825.  
  826. Sub SelectText (ThisControl As Control)
  827.   ThisControl.SelStart = 0
  828.   ThisControl.SelLength = Len(ThisControl.Text)
  829. End Sub
  830.  
  831. Sub StrKP (ThisControl As Control, Length%, KeyAscii As Integer)
  832.     If Len(ThisControl.Text) = Length% Then
  833.       If ThisControl.SelLength <> Length% Then
  834.         If KeyAscii <> 8 Then
  835.           KeyAscii = 0
  836.           Beep
  837.         End If
  838.       End If
  839.     End If
  840. End Sub
  841.  
  842. Sub UCStrKP (ThisControl As Control, Length%, KeyAscii As Integer)
  843.     If Len(ThisControl.Text) = Length% Then
  844.       If ThisControl.SelLength <> Length% Then
  845.         If KeyAscii <> 8 Then
  846.           KeyAscii = 0
  847.           Beep
  848.         End If
  849.       End If
  850.     Else
  851.         KeyAscii = Asc(UCase$(Chr$(KeyAscii)))
  852.     End If
  853. End Sub
  854.  
  855.